home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / program / rfm.zip / DYNSLIM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-27  |  8KB  |  277 lines
  1. {******************************************************}
  2. {            Slim Dynamic Array Class v3.0             }
  3. {        Copyright 1997 RealSoft Development           }
  4. {           support:  www.realsoftdev.com              }
  5. {                    ------------                      }
  6. { This is a slim version on the Dynarray Class         }
  7. { to be distributed with your source code.  RealSoft   }
  8. { grants an unrestricted license to include this unit  }
  9. { in its un modified format.  For a full featured      }
  10. { version, contact dan@realSoftdev.com, or visit the   }
  11. { Compuserve Delphi forum.  Do not remove this notice. }
  12. {******************************************************}
  13.  
  14. unit Dynslim;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, WinTypes, WinProcs, Messages, Classes, Dialogs;
  20.  
  21. type
  22.   EDynArrayException    = class(Exception);
  23.   EDynArrayCreateError  = class(EDynArrayException);
  24.   EDynArrayIndexBounds  = class(EDynArrayException);
  25.   EDynArrayResources    = class(EDynArrayException);
  26.   EDynArrayFileError    = class(EDynArrayException);
  27.   EDynArrayAddError     = class(EDynArrayException);
  28.   EDynArrayDelError     = class(EDynArrayException);
  29.  
  30.   TDynArray = class
  31.     private
  32.       FPointer     : Pointer;
  33.       FItemSize    : Longint;
  34.       FItemCount   : Longint;
  35.       FArraySize   : LongInt;
  36.       function  GetItems (Index : Longint) : pointer;
  37.     public
  38.       constructor Create ( ItemSize : Longint );
  39.       destructor  Destroy; override;
  40.       function    Clear  : Pointer;
  41.       function    Add    ( const Item ) : Pointer;
  42.       function    Delete ( Index : Longint  ) : Pointer;
  43.       function    SaveToFile   ( filename : String ) : Pointer;
  44.       function    LoadFromFile ( filename : String ) : Pointer;
  45.       function    Assign ( FromDyn : TDynarray ) : Pointer;
  46.       property Count       : Longint   read FItemCount;
  47.       property Size        : Longint   read FArraySize;
  48.       property ItemSize    : Longint   read FItemSize;
  49.       property DataPtr     : Pointer   read FPointer;
  50.       property Items[Index: longint]: Pointer read GetItems; default;
  51.     end;
  52.  
  53. implementation
  54.  
  55. {***********************}
  56. {  Create & Initialize  }
  57. {***********************}
  58. constructor TDynArray.Create( ItemSize : Longint );
  59. begin
  60.   inherited create;
  61.   if (ItemSize > 0) and (ItemSize < 65520) then begin
  62.     FItemCount:= 0;
  63.     FArraySize:= 0;
  64.     FItemSize:= ItemSize;
  65.     FPointer:= nil;
  66.     end
  67.   else raise EDynArrayCreateError.Create('Dynamic Array: Invalid Item Size');
  68. end;
  69.  
  70. {***********************}
  71. {    Destroy & Free     }
  72. {***********************}
  73. destructor TDynArray.Destroy;
  74. begin
  75.   Clear;
  76.   FItemSize:= 0;
  77.   inherited destroy;
  78. end;
  79.  
  80. {***********************}
  81. {      Clear Array      }
  82. {***********************}
  83. function TDynArray.Clear : pointer;
  84. begin
  85.   if FItemCount > 0 then begin
  86.     FreeMem(FPointer, FArraySize);
  87.     FItemCount:= 0;
  88.     FArraySize:= 0;
  89.     end;
  90.   result:= NIL;
  91. end;
  92.  
  93. {***********************}
  94. { Add an Array Element  }
  95. {***********************}
  96. function TDynArray.Add ( const Item ) : Pointer;
  97. var P : Pointer;
  98. begin
  99.   if FItemSize > 0 then begin
  100.     {Allocate next memory element}
  101.     if FItemCount = 0 then GetMem( FPointer, FItemSize )
  102.     else
  103.     {$IFDEF Win32}
  104.       ReAllocMem( FPointer, FArraySize + FItemSize );
  105.     {$ELSE}
  106.       FPointer:= ReAllocMem( FPointer, FArraySize, FArraySize + FItemSize );
  107.     {$ENDIF}
  108.  
  109.     if FPointer <> nil then begin {check for valid pointer}
  110.       {advance counters}
  111.       inc(FItemCount);
  112.       inc(FArraySize, FItemSize);
  113.       {move data into array memory}
  114.       P:= FPointer;
  115.       inc( longint(P), (FItemSize * (FItemCount - 1)) );
  116.       move( Item, P^, FItemSize );
  117.       end
  118.     else raise EDynArrayResources.Create('Dynamic Array: Out of resources during Add.');
  119.     end
  120.   else begin
  121.     raise EDynArrayAddError.Create('Dynamic Array: Unable to add element.');
  122.     FPointer:= nil;
  123.     end;
  124.   {return pointer}
  125.   Result:= FPointer;
  126. end;
  127.  
  128. {**********************}
  129. { Del an Array Element }
  130. {**********************}
  131. function TDynArray.Delete( Index: Longint ) : Pointer;
  132. var
  133.   x        : smallint;
  134.   P1 : Pointer;
  135.   P2 : Pointer;
  136. begin
  137.   if FItemCount > 0 then begin
  138.     if (Index < FItemCount - 1) then begin
  139.       {move items to fill gap}
  140.       P1:= FPointer;
  141.       inc( longint(P1), FItemSize * Index );
  142.       P2:= FPointer;
  143.       inc( longint(P2), FItemSize * (Index + 1) );
  144.       for x:= Index to FItemCount - 2 do begin
  145.         move( P2^, P1^, FItemSize );
  146.         inc( longint(P1), FItemSize );
  147.         inc( longint(P2), FItemSize );
  148.         end;
  149.       end;
  150.     {resize array to clip last item}
  151.  
  152.     {$IFDEF Win32}
  153.       ReAllocMem( FPointer, FArraySize - FItemSize );
  154.     {$ELSE}
  155.       Fpointer:= ReAllocMem( FPointer, FArraySize, FArraySize - FItemSize );
  156.     {$ENDIF}
  157.  
  158.     Dec(FArraySize, FItemSize);
  159.     Dec(FItemCount);
  160.     end
  161.   else begin
  162.     raise EDynArrayDelError.Create('Dynamic Array: Unable to delete element.');
  163.     FPointer:= nil;
  164.     end;
  165.   {return pointer}
  166.   Result:= FPointer;
  167. end;
  168.  
  169. {*********************}
  170. { Save Array to File  }
  171. {*********************}
  172. function TDynArray.SaveToFile ( filename : String ) : Pointer;
  173. var
  174.   handle, x   : smallint;
  175.   P     : Pointer;
  176. begin
  177.   if FItemCount > 0 then begin
  178.     if fileexists( FileName ) then
  179.  
  180.       {$IFDEF Win32}
  181.         DeleteFile( PChar(FileName) );
  182.       {$ELSE}
  183.         DeleteFile( FileName );
  184.       {$ENDIF}
  185.  
  186.     handle:= FileCreate( FileName );
  187.     if handle > - 1 then begin
  188.       P := FPointer;
  189.       for x:= 0 to FItemCount - 1 do begin
  190.         FileWrite( handle, P^, FItemSize );
  191.         inc( longint(P), FItemSize );
  192.         end;
  193.       FileClose(handle);
  194.       end
  195.     else raise EDynArrayFileError.Create('Dynamic Array: Unable to create file.');
  196.     end
  197.   else begin
  198.     raise EDynArrayFileError.Create('Dynamic Array: No elements to save.');
  199.     FPointer:= nil;
  200.     end;
  201.   {return pointer}
  202.   Result:= FPointer;
  203. end;
  204.  
  205. {*********************}
  206. {Load Array from File }
  207. {*********************}
  208. function TDynArray.LoadFromFile ( filename : String ) : Pointer;
  209. var
  210.   handle, x   : smallint;
  211.   tmpptr      : Pointer;
  212. begin
  213.   if FItemSize > 0 then begin
  214.     if fileexists( FileName ) then begin
  215.       if FItemCount > 0 then begin
  216.         FreeMem(FPointer, FArraySize);
  217.         FItemCount:= 0;
  218.         FArraySize:= 0;
  219.         FPointer:= nil;
  220.         end;
  221.       handle:= FileOpen( FileName, 0 );
  222.  
  223.       GetMem( tmpptr, FItemSize );
  224.  
  225.       while ( FileRead( handle, tmpptr^, FItemSize ) = FItemSize ) do
  226.         FPointer:= Add(tmpptr^);
  227.       FileClose(handle);
  228.       {clean up}
  229.       FreeMem( tmpptr, FItemSize );
  230.       end
  231.     else raise EDynArrayFileError.Create('Dynamic Array: File does not exist.');
  232.   end
  233.   else begin
  234.     raise EDynArrayFileError.Create('Dynamic Array: Element size unknown.');
  235.     FPointer:= nil;
  236.     end;
  237.   {return pointer}
  238.   Result:= FPointer;
  239. end;
  240.  
  241. {*********************}
  242. {  Item Array Access  }
  243. {*********************}
  244. function TDynArray.GetItems(Index : Longint) : pointer;
  245. var P : pointer;
  246. begin
  247.   if Index > FItemCount-1 then begin
  248.     raise EDynArrayIndexBounds.Create('Dynamic Array: Index out of bounds.');
  249.     Exit;
  250.     end;
  251.   P:= FPointer;
  252.   inc(longint(P), longint(Index * FItemSize));
  253.   Result:= P;
  254. end;
  255.  
  256. function TDynArray.Assign ( FromDyn : TDynarray ) : Pointer;
  257. begin
  258.   if FromDyn.ItemSize = FItemSize then begin
  259.     {Free the old array, if any}
  260.     if FItemCount > 0 then begin
  261.       FreeMem(FPointer, FArraySize);
  262.       FItemCount:= 0;
  263.       FArraySize:= 0;
  264.       FPointer:= nil;
  265.       end;
  266.     {Create & Assign the array}
  267.     FItemCount:= FromDyn.Count;
  268.     FArraySize:= FromDyn.Size;
  269.     GetMem( FPointer, FArraySize );
  270.     move( FromDyn.DataPtr^, FPointer^, FArraySize );
  271.     end
  272.   else raise EDynArrayException.Create('Dynamic Array: Arrays not compatible for Assign.');
  273.   Result:= FPointer;
  274. end;
  275.  
  276. end.
  277.